home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
graphic
/
postogrf.zip
/
SCANPS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-05-24
|
7KB
|
179 lines
{ Scanps.pas - include file used in POSTOGRF.
Scans input file for internal markers indicating label positions, font
definitions, etc.
9 Jan 89. Minor cleanup.
1 May 89 Now scans to end to look for %StartLabels, %EndLabels; now can
pick up labels this way even if they are at the end of the file.
}
procedure ScanPSOffsets;
const SetOriginSt = '/setorigin';
type chArray1 = array[1..length(SetOriginSt)] of char;
chArray1Ptr = ^chArray1;
const SetOriginName: chArray1 = SetOriginSt;
var saveHere, marker, nn, limit, dobar: word;
s: string80;
done: boolean;
procedure FindPhrase(target:string80; limit: word; var marker:word);
var saveHere: word;
s, s1: string80;
begin
done := false;
saveHere := here;
s1 := target[1];
repeat
repeat inc(here) until (JimFile^[here] = s1) or (here > limit);
if here > limit then begin
marker := limit;
done := true;
end
else begin
GetAWord(s);
if s = target then done := true;
end;
until done;
if here > limit then marker := limit else begin
marker := here;
while jimfile^[marker] in pwhitespace do inc(marker);
end;
here := saveHere;
end; {FindPhrase}
procedure GetOriginFromString;
var badOrigin: boolean;
s1: string;
n1, n2: byte;
tx,ty: real;
err: integer;
begin
badorigin := false;
if pos('translate', SetOriginStr) = 0 then badOrigin := true;
n1 := 0;
repeat inc(n1);
until (SetOriginStr[n1] in numbers) or (n1 > 80);
if n1 > 80 then badOrigin := true else begin
n2 := n1;
repeat inc(n2) until not (SetOriginStr[n2] in numbers);
val(copy(SetOriginStr,n1, n2 - n1), tx, err);
if err <> 0 then badOrigin := true else begin
repeat inc(n2)
until (SetOriginStr[n2] in numbers) or (n2 > 80);
if n2 > 80 then badOrigin := true else begin
n1 := n2;
repeat inc(n1) until not (SetOriginstr[n1] in numbers);
val(copy(SetOriginStr, n2, n1-n2), ty, err);
if err <> 0 then BadOrigin := true;
end;
end;
end;
case badOrigin of
true : begin
Layout.Origin := DefaultLayout.Origin;
end;
false: begin
with Layout do begin
if (pos('rotate', SetOriginStr) = 0) then
Landscape := false
else Landscape := true;
origin.x := integer(round(1000*tx));
origin.y := integer(round(1000*ty));
ChangeLayout := false;
end;
end;
end; {case badOrigin of ...}
end; {GetOriginFromString}
procedure GetBoundingBox;
var BBstr: string;
badBBox: boolean;
n1, n2: word;
x1, x2, y1, y2, err: integer;
begin
badBBox := false; n2 := 255;
FindPhrase('%%BoundingBox:', n2, n1);
if n1 >= n2 then badBBox := true else begin
BBstr := '';
n2 := n1;
while Jimfile^[n2] <> CR do begin
BBstr := BBstr + JimFile^[n2];
inc(n2);
end;
end;
if not badBBox then begin
n1 := 1; n2 := n1;
repeat inc(n2) until not (BBstr[n2] in numbers);
val(copy(BBstr, n1, n2-n1), x1, err);
if err <> 0 then badBBox := true else begin
repeat inc(n2) until BBstr[n2] in numbers ;
n1 := n2;
repeat inc(n2) until not (BBstr[n2] in numbers);
val(copy(BBstr, n1, n2-n1), y1, err);
if err <> 0 then badBBox := true else begin
repeat inc(n2) until BBstr[n2] in numbers ;
n1 := n2;
repeat inc(n2) until not (BBstr[n2] in numbers);
val(copy(BBstr, n1, n2-n1), x2, err);
if err <> 0 then badBBox := true else begin
repeat inc(n2) until BBstr[n2] in numbers ;
n1 := n2;
repeat inc(n2) until not (BBstr[n2] in numbers);
val(copy(BBstr, n1, n2-n1), y2, err);
if err <> 0 then badBBox := true;
end;
end;
end;
end;
case badBBox of
true : begin
layout.BoundingBox := defaultLayout.BoundingBox;
end;
false: with Layout.BoundingBox do begin
LLx := x1; LLy := y1; URx := x2; URy := y2;
w := x2 - x1; h := y2 - y1;
end;
end; {case badBBox of ...}
end; {GetBoundingBox}
begin {ScanPSOffsets}
saveHere := here;
here := 1;
{ ------------------ find '/setorigin' ------------------------ }
SetOriginStr := '';
repeat inc(here) until (chArray1Ptr(@Jimfile^[here])^ = SetOriginName)
or (here > count);
if here > count then SetOrigin := count
else begin
marker := here;
repeat GetAWord(s)
until (s = 'def') or (here > count);
if here < count then
for nn := marker to here do
SetOriginStr := SetOriginStr + JimFile^[nn];
end;
here := 1;
if SetOriginStr = '' then SetOriginStr := DefaultOriginStr;
GetOriginFromString;
GetBoundingBox;
here := count - 5;
repeat GetAWordBack(s, here); until s = 'showpage';
count := here;
here := 1;
{ ----------------- find other key words ----------------------- }
FindPhrase('%EndLabels', count, EndLabels);
FindPhrase('%StartLabels', EndLabels, StartLabels);
FindPhrase('%EndGraph', count, EndGraph);
FindPhrase('%StartGraph', EndGraph, StartGraph);
FindPhrase('%%EndProlog', StartLabels, EndProlog);
here := endprolog;
FindPhrase('dobar', EndLabels, dobar);
here := 1;
FindPhrase('%EndFonts', EndProlog, EndFonts);
FindPhrase('%FontDefinitions', EndFonts, FontDefinitions);
here := saveHere;
if dobar < EndLabels then LConfig.DoBar := true
else Lconfig.DoBar := false;
SetCopyBlockDef;
end; {ScanPSOffsets}